home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / spoc88.zip / SCRHND.ZIP / XTPREDS.PRO < prev   
Text File  |  1988-04-18  |  6KB  |  207 lines
  1. /* Listing 2: XTPREDS.PRO    */
  2.  
  3. /****************************************************************
  4.      Turbo Prolog Toolbox
  5.      (C) Copyright 1987 Borland International.                
  6.                                                               
  7.  This module includes some routines which are used in nearly  
  8.  all menu and screen tools.                                   
  9. ****************************************************************/
  10. /***************************************************************
  11.  * Modified 2/5/88 G. Wood
  12.  *  Added the '+' key (as 'plus') to be a recognized key
  13.  *  See predicate readkey1 (below) and changes in XTDOMS.PRO
  14.  *      and XSCRHND.PRO
  15.  ***************************************************************/
  16. /****************************************************************/
  17. /*        repeat                        */
  18. /****************************************************************/
  19.  
  20. PREDICATES
  21.   nondeterm repeat
  22.  
  23. CLAUSES
  24.   repeat.
  25.   repeat:-repeat.
  26.  
  27.  
  28. /****************************************************************/
  29. /*        miscellaneous                    */
  30. /****************************************************************/
  31.  
  32. PREDICATES
  33.   maxlen(STRINGLIST,COL,COL)      
  34.       /* The length of the longest string */
  35.   listlen(STRINGLIST,ROW)     
  36.       /* The length of a list            */
  37.   writelist(ROW,COL,STRINGLIST)      
  38.       /* used in the menu predicates        */
  39.   reverseattr(ATTR,ATTR)    
  40.       /* Returns the reversed attribute   */
  41.   min(ROW,ROW,ROW) 
  42.   min(COL,COL,COL) 
  43.   min(LEN,LEN,LEN) 
  44.   min(INTEGER,INTEGER,INTEGER)
  45.   max(ROW,ROW,ROW) max(COL,COL,COL) 
  46.   max(LEN,LEN,LEN) max(INTEGER,INTEGER,INTEGER)
  47.  
  48. CLAUSES
  49.   maxlen([H|T],MAX,MAX1) :-
  50.     str_len(H,LENGTH),
  51.     LENGTH>MAX,!,
  52.     maxlen(T,LENGTH,MAX1).
  53.   maxlen([_|T],MAX,MAX1) :- maxlen(T,MAX,MAX1).
  54.   maxlen([],LENGTH,LENGTH).
  55.  
  56.   listlen([],0).
  57.   listlen([_|T],N):-
  58.     listlen(T,X),
  59.     N=X+1.
  60.  
  61.   writelist(_,_,[]).
  62.   writelist(LI,ANTKOL,[H|T]):-
  63.     field_str(LI,0,ANTKOL,H),
  64.     LI1=LI+1,
  65.     writelist(LI1,ANTKOL,T).
  66.  
  67.   min(X,Y,X):-X<=Y,!.
  68.   min(_,X,X).
  69.  
  70.   max(X,Y,X):-X>=Y,!.
  71.   max(_,X,X).
  72.  
  73.   reverseattr(A1,A2):-
  74.     bitand(A1,$07,H11),
  75.     bitleft(H11,4,H12),
  76.     bitand(A1,$70,H21),
  77.     bitright(H21,4,H22),
  78.     bitand(A1,$08,H31),
  79.     A2=H12+H22+H31.
  80.  
  81.  
  82. /****************************************************************/
  83. /*    Find letter selection in a list of strings        */
  84. /*      Look initially for first uppercase letter.        */
  85. /*      Then try with first letter of each string.        */
  86. /****************************************************************/
  87.  
  88. PREDICATES
  89.   upc(CHAR,CHAR)  lowc(CHAR,CHAR)
  90.   try_upper(CHAR,STRING)
  91.   tryfirstupper(CHAR,STRINGLIST,ROW,ROW)
  92.   tryfirstletter(CHAR,STRINGLIST,ROW,ROW)
  93.   tryletter(CHAR,STRINGLIST,ROW)
  94.  
  95. CLAUSES
  96.   upc(CHAR,CH):-
  97.     CHAR>='a',CHAR<='z',!,
  98.     char_int(CHAR,CI), CI1=CI-32, char_int(CH,CI1).
  99.   upc(CH,CH).
  100.  
  101.   lowc(CHAR,CH):-
  102.     CHAR>='A',CHAR<='Z',!,
  103.     char_int(CHAR,CI), CI1=CI+32, char_int(CH,CI1).
  104.   lowc(CH,CH).
  105.  
  106.   try_upper(CHAR,STRING):-
  107.     frontchar(STRING,CH,_),
  108.     CH>='A',CH<='Z',!,
  109.     CH=CHAR.
  110.   try_upper(CHAR,STRING):-
  111.     frontchar(STRING,_,REST),
  112.     try_upper(CHAR,REST).
  113.  
  114.   tryfirstupper(CHAR,[W|_],N,N) :-
  115.     try_upper(CHAR,W),!.
  116.   tryfirstupper(CHAR,[_|T],N1,N2) :-
  117.     N3 = N1+1,
  118.     tryfirstupper(CHAR,T,N3,N2).
  119.  
  120.   tryfirstletter(CHAR,[W|_],N,N) :-
  121.     frontchar(W,CHAR,_),!.
  122.   tryfirstletter(CHAR,[_|T],N1,N2) :-
  123.     N3 = N1+1,
  124.     tryfirstletter(CHAR,T,N3,N2).
  125.  
  126.   tryletter(CHAR,LIST,SELECTION):-
  127.     upc(CHAR,CH),tryfirstupper(CH,LIST,0,SELECTION),!.
  128.   tryletter(CHAR,LIST,SELECTION):-
  129.     lowc(CHAR,CH),tryfirstletter(CH,LIST,0,SELECTION).
  130.  
  131.  
  132.  
  133. /*****************************************************************/
  134. /* adjustwindow takes a windowstart and a windowsize and adjusts */
  135. /* the windowstart so the window can be placed on the screen.     */
  136. /* adjframe looks at the frameattribute: if it is different from */
  137. /* zero, two is added to the size of the window             */
  138. /****************************************************************/
  139.  
  140. PREDICATES
  141.   adjustwindow(ROW,COL,ROW,COL,ROW,COL)
  142.   adjframe(ATTR,ROW,COL,ROW,COL)
  143.  
  144. CLAUSES
  145.   adjustwindow(LI,KOL,DLI,DKOL,ALI,AKOL):-
  146.         LI<25-DLI,KOL<80-DKOL,!,ALI=LI,AKOL=KOL.
  147.   adjustwindow(LI,_,DLI,DKOL,ALI,AKOL):-
  148.         LI<25-DLI,!,ALI=LI,AKOL=80-DKOL.
  149.   adjustwindow(_,KOL,DLI,DKOL,ALI,AKOL):-
  150.         KOL<80-DKOL,!,ALI=25-DLI, AKOL=KOL.
  151.   adjustwindow(_,_,DLI,DKOL,ALI,AKOL):-
  152.         ALI=25-DLI, AKOL=80-DKOL.
  153.  
  154.   adjframe(0,R,C,R,C):-!.
  155.   adjframe(_,R1,C1,R2,C2):-R2=R1+2, C2=C1+2.
  156.  
  157.  
  158. /****************************************************************/
  159. /*             Readkey                    */
  160. /* Returns a symbolic key from the KEY domain                */
  161. /****************************************************************/
  162. /****************************************************************/
  163. /*  Modified 2/5/88 G.Wood                                      */
  164. /*   Added readkey1 clause for symbolic key 'plus' with ASCII 43*/
  165. /****************************************************************/
  166.  
  167.  
  168. PREDICATES
  169.   readkey(KEY)
  170.   readkey1(KEY,CHAR,INTEGER)
  171.   readkey2(KEY,INTEGER)
  172.  
  173. CLAUSES
  174.   readkey(KEY):-readchar(T),char_int(T,VAL),readkey1(KEY,T,VAL).
  175.  
  176.   readkey1(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL).
  177.   readkey1(cr,_,13):-!.
  178.   readkey1(esc,_,27):-!.
  179.   readkey1(break,_,3):-!.
  180.   readkey1(tab,_,9):-!.
  181.   readkey1(bdel,_,8):-!.
  182.   readkey1(ctrlbdel,_,127):-!.
  183.   readkey1(plus,_,43):-!.
  184.   readkey1(char(T),T,_) .
  185.   
  186.   readkey2(btab,15):-!.
  187.   readkey2(del,83):-!.
  188.   readkey2(ins,82):-!.
  189.   readkey2(up,72):-!.
  190.   readkey2(down,80):-!.
  191.   readkey2(left,75):-!.
  192.   readkey2(right,77):-!.
  193.   readkey2(pgup,73):-!.
  194.   readkey2(pgdn,81):-!.
  195.   readkey2(end,79):-!.
  196.   readkey2(home,71):-!.
  197.   
  198.   readkey2(ctrlleft,115):-!.
  199.   readkey2(ctrlright,116):-!.
  200.   readkey2(ctrlend,117):-!.
  201.   readkey2(ctrlpgdn,118):-!.
  202.   readkey2(ctrlhome,119):-!.
  203.   readkey2(ctrlpgup,132):-!.
  204.   readkey2(fkey(N),VAL):- VAL>58, VAL<70, N=VAL-58, !.
  205.   readkey2(fkey(N),VAL):- VAL>=84, VAL<104, N=11+VAL-84, !.
  206.   readkey2(otherspec,_).
  207.